PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/arith2.com/ARITH_DE.PAS

Pascal/Delphi Source File | 1989-02-27 | 6.9 KB | 250 lines

UNIT arith_de;

        { ------------------------------------------------------------------

          This program and its associates implement in Turbo Pascal v5
          the aritmetic encoding/decoding algorithms presented in the papers

          "Arithmetic Coding for Data Compression"

                   by Ian     H. Witten
                      Radford M. Neal
                      John    G. Cleary

          pp 520 - 540 of June 1987 Communications of the ACM

          and

          "An Adaptive Dependency Source Model For Data Compression"

                   by David M. Abrahamson

          pp 77 - 83 of January 1989 Communications of the ACM

          ------------------------------------------------------------------

          Implemented by Ken Westerback : CompuServe 73547,3520

          version 1.0 released 89/02/19
          version 2.0 released 89/02/27

          These programs, units and associated documentation are released
          into the public domain to be used and abused as your whims
          dictate.

          Feel free to distribute/incorporate/improve as desired.

          >>>>> Use at your own risk! <<<<<

          Comments and suggestions welcome via CompuServe.

          ------------------------------------------------------------------
        }


INTERFACE uses dos;


function start_decoding ( f_name : pathstr ) : char;

function decode_symbol ( var symbol : integer ) : boolean;

function done_decoding : longint;


IMPLEMENTATION uses model_h, arith_h;


var file_size, chars_to_read : longint;


procedure read_big_buffer;
          begin

          { try to read next bit_buffer }

          fillchar ( big_buffer, sizeof(big_buffer), 0 );

          if not eof ( bits_file ) then
             begin

             if ( file_size < sizeof(big_buffer) ) then
                chars_to_read := file_size
             else
                chars_to_read := sizeof(big_buffer);

             blockread ( bits_file, big_buffer, chars_to_read );

             dec ( file_size, chars_to_read );

             buffer_index := 0;
             buffer       := big_buffer[ buffer_index ];
             bits_to_go   := bits_per_buffer;

             end

          else { send up to code_value_bits arbitrary bits }
             begin
             if sending_crap then
                begin
                writeln ( 'decoding failed : bad input file' );
                halt;
                end
             else
                begin
                sending_crap := true;
                buffer_index := 511;
                bits_to_go   := code_value_bits - 2;
                end;
             end;

          end; { read big buffer }

function start_decoding ( f_name : pathstr ) : char;

          var     i : integer;
              model : char;

          begin

          {I-}
          Assign ( bits_file, f_name );
          Reset ( bits_file, 1 );
          {I+}

          if ioresult <> 0 then
             begin
             writeln;
             writeln ( 'arith_de : error opening "', f_name, '"' );
             writeln;
             halt;
             end;

          file_size := filesize ( bits_file ) - 1; { discount model byte }

          blockread ( bits_file, model, 1 );

          if not ( model in valid_models ) then
             begin
             writeln;
             writeln ( 'arith_de : "', model, '" is not a valid model' );
             writeln;
             halt;
             end;

          start_decoding := model;

          read_big_buffer;

          { input enough bits to initially fill the code value }

          for i := 1 to code_value_bits do
              begin
              value := value shl 1;
              if odd ( buffer ) then inc ( value );
              buffer := buffer shr 1;
              inc ( bits_gotten );
              dec ( bits_to_go );
              end;

          end;

function decode_symbol ( var symbol : integer ) : boolean;

          var range : longint; { size of the current code region }
              cum   : word;    { cumulative frequency calculated }
              i     : integer;

          begin

          range := longint ( high - low ) + 1;

          { find the cumulative frequency for value }

          cum := ( ( longint(value) - low + 1 ) * cum_freq[ 0 ] - 1 ) div range;

          { then find the symbol }

          symbol := 1;
          while ( cum_freq[ symbol ] > cum ) do inc ( symbol );

          if symbol = eof_symbol then decode_symbol := false
          else                        decode_symbol := true;

          { narrow the code region to that alloted to this symbol }

          high := low + ( ( range * cum_freq[ symbol-1 ] ) div cum_freq[ 0 ] ) - 1;
          low  := low +   ( range * cum_freq[ symbol   ] ) div cum_freq[ 0 ] ;

          { loop to get rid of bits }

          while true do
                begin

                if      ( high < half ) then
                   { do nothing = expand low half }

                else if ( low >= half ) then
                    { expand high half by subtracting offet to top }
                    begin
                    dec ( value, half );
                    dec ( low,   half );
                    dec ( high,  half );
                    end

                else if ( low >= first_qtr ) and ( high < third_qtr ) then
                    { expand the middle half by subtracting the offset to middle }
                    begin
                    dec ( value, first_qtr );
                    dec ( low,   first_qtr );
                    dec ( high,  first_qtr );
                    end

                else exit; { all done so return to caller }

                { scale up the code range & move in next bit }

                low   := low shl 1;
                high  := ( high shl 1 )+ 1;

                value := value shl 1;

                if odd ( buffer ) then inc ( value );
                inc ( bits_gotten );

                { update bit buffers }

                dec ( bits_to_go );
                buffer := buffer shr 1;

                if ( bits_to_go = 0 ) then
                   begin

                   inc ( buffer_index );

                   if ( buffer_index = 512 ) then
                      read_big_buffer

                   else
                      { just get next word }
                      begin
                      buffer := big_buffer[ buffer_index ];
                      bits_to_go := bits_per_buffer;
                      end;

                   end;

                end;

          end; { decode the next symbol }

function done_decoding : longint;
          begin

          close ( bits_file );

          done_decoding := ( bits_gotten + 7 ) div 8;

          end; { done_decoding }

END. { arithmetic decoding implementation }